
VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} Memo 
   Caption         =   "Тренажёр текстовой памяти"
   ClientHeight    =   2670
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   5910
   OleObjectBlob   =   "Memo.frx":0000
   StartUpPosition =   1  'CenterOwner
End
Attribute VB_Name = "Memo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function GetTickCount& Lib "kernel32" () 'даёт время с точностью до миллисекунды
Dim sTime, etal As String

Private Sub RTB1_KeyDown(KeyCode As Integer, ByVal Shift As Integer)
  If KeyCode <> 13 Then Exit Sub

  seq = Array("—", "-", "ё", "е", "Ё", "Е") 'взаимозаменяемые символы
  Dim st As Worksheet
  Set st = Sheets("Stats") 'лист итогов
  
  TType = Trim(Me.RTB1.Text): TSmpl = etal
  If Len(TType) > 0 Then TType = Replace(Replace(TType, Chr(13), ""), Chr(10), "")
    
 'индусская заплатка (препятствует исчезновению последнего слова)
  If Len(TType) > 0 Then Me.RTB1.Text = TType & " "
  
  If Len(TType) > 0 Then
    If rwOpts("vr") = 1 Then
      With Me.RTB2
        LT = Len(.Text) 'длина текущего отрывка
        .Text = .Text & etal
        .SelStart = 0: .SelLength = LT
        .SelColor = GC("Пред. отрывок:")(6)
      
        .SelStart = LT + 1: .SelLength = Len(etal)
        .SelColor = GC("Совпало:")(6)
      End With
    Else: Me.RTB2 = etal
    End If
    
    For i = 0 To UBound(seq) Step 2 'приводим символы к одному виду
      TType = Replace(TType, seq(i), seq(i + 1))
      TSmpl = Replace(TSmpl, seq(i), seq(i + 1))
    Next
    If rwOpts("ds") = 0 Then 'убираем регистр (если надо)
      TType = LCase(TType)
      TSmpl = LCase(TSmpl)
    End If
    
    If rwOpts("dp") = 0 Then 'убираем пунктуацию (если надо)
      smv = Trim(smv)
      For i = 1 To Len(TType)
        s = Mid(TType, i, 1)
        If InStr(smv, s) = 0 Then txt = txt & s
      Next
      TType = txt: txt = ""
      For i = 1 To Len(TSmpl)
        s = Mid(TSmpl, i, 1)
        If InStr(smv, s) = 0 Then txt = txt & s
      Next
      TSmpl = txt: txt = ""
    End If
    
    rText = InStr(Memo.RTB2.Text, Chr(10))
    If rText > 0 Then
      Memo.RTB2.Text = Mid(Memo.RTB2.Text, rText + 2)
    End If
    itog = errmath(Trim(TType), TSmpl) 'проверка правильности
    elap = Format((GetTickCount - sTime) / 1000, "0")
    Rezalts itog, st, elap, Val(Me.TimeOut)
  Else 'если ничего не набрано
    Me.Fint = st2fint(stage + 2) '4
  End If
End Sub

Private Sub RTB1_KeyPress(KeyAscii As Integer)
  If Len(Me.RTB1.Text) > 1 Then
    elap = (GetTickCount - sTime) / 1000
    TimeOut.Caption = Format(Len(Me.RTB1.Text) * 60 / elap, "0 зн/мин")
  ElseIf Len(Me.RTB1.Text) = 1 Then
    If rwOpts("tv") = 0 Then 'обратный таймер (секундомер)?
      tTime = GetTickCount - sTime
      With Me.RTB1
        .SelStart = 0: .SelLength = 1 'попытка нащупать начало (неудачная)
        .SelBold = 0
        .SelColor = 0
        .SelStart = 1
      End With
      rText = InStr(Me.RTB2.Text, Chr(10)) 'отображён ли пред. отрывок?
      If rText > 0 Then
        Me.RTB2.Text = Left(Memo.RTB2.Text, rText) & "…"
        ResizElems
      Else: Memo.RTB2 = ""
      End If
      sTime = GetTickCount
    End If
  End If
End Sub

Private Sub UserForm_Activate()
  If Len(Me.RTB2) = 0 Then Unload Me 'тут надо что-то похитрее...
End Sub

Private Sub UserForm_Initialize()
  If stage = 3 Then stage = 5
  If stage = 0 Then
    Me.Fint = st2fint(stage) '0
    Me.RTB1 = ">> поле для набора >> …"
    intro = ThisWorkbook.Path & "\Intro.txt"
    If Dir(intro) = "" Then 'проверяем наличие файла
    Else
      Open intro For Input As #1 'считываем заставку
         Me.RTB2.Text = Input(LOF(1), #1)
      Close #1
    End If
    Exit Sub
  End If
  
  etal = CropText
  If Len(etal) = 0 Then
    MsgBox "Набран весь текст, выберите другой файл", 64, "The end"
    Exit Sub
  Else
    Me.RTB1 = ""
    Me.RTB1.Enabled = False 'когда будет реализован адаптивный таймер, то здесь надо по условию
    With Me.RTB2
      If rwOpts("vr") = 1 Then 'если сохраняем предыдущий отрывок
        If stage = 1 Then 'если первый запуск
          .Text = etal

          .SelStart = 0: .SelLength = Len(etal)
          .SelColor = GC("Совпало:")(6)
        Else
          LOtr = Len(.Text)
          .Text = .Text & Chr(10) & etal
        
          .SelStart = 0: .SelLength = LOtr + 1
          .SelColor = GC("Пред. отрывок:")(6)
          .SelStart = LOtr + 1: .SelLength = Len(etal)
          .SelColor = GC("Совпало:")(6)
        
          ResizElems
        End If
      Else
        .Text = etal
        .SelStart = 0: .SelLength = Len(etal)
        Ci = GC("Совпало:") 'общая раскраска
        .SelColor = Ci(6)
        If Len(Ci(3)) > 0 Then .SelBold = Ci(3)
        If Len(Ci(4)) > 0 Then .SelUnderline = Ci(4)
        If Len(Ci(5)) > 0 Then .SelItalic = Ci(5)
      End If
    End With

    If Me.RTB3.Visible Then 'отображается ли оперстата?
      Me.RTB3 = ""
      ResizElems
    End If
    
    If rwOpts("tv") = 0 Then
      Me.TimeOut = -1: sTime = GetTickCount: tTime = 0
    Else
      Me.TimeOut = rwOpts("tv") + 1
    End If
    TCount
  End If
End Sub

Private Sub UserForm_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  If KeyCode = 13 Then
    If stage = 3 Then UserForm_Initialize 'переход к следующему отрывку
    If stage = 0 Then stage = 1: UserForm_Initialize
  End If
End Sub

Private Sub UserForm_Terminate()
  stage = 0
End Sub
